home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Paragrapher / Paragrapher.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  2.2 KB  |  94 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10.  
  11. unit Paragrapher;
  12.  
  13. interface
  14.  
  15.     uses
  16.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  17.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  18.  
  19.  
  20.  
  21. {$MAIN}
  22.                         
  23.     procedure main;        
  24.  
  25. implementation
  26.  
  27.     procedure dopaste;
  28.     const
  29.         pastecode=2422;
  30.     var 
  31.         qel: EvQelPtr;
  32.     begin
  33.             if ppostevent(3, pastecode, qel) = noerr then
  34.             qel^.evtqmodifiers := cmdkey;
  35.     end;
  36.  
  37.     
  38.     
  39.     procedure main;
  40.         const
  41.             step = 1000;
  42.             tab = char(ord(9));
  43.             esc = char(ord(27));
  44.             Enter = char(ord(3));                                {the enter character}
  45.             Return = char(ord(13));                                {the return character}
  46.             space = ' ';
  47.             dash='-';
  48.             bullet='•';
  49.             
  50.         Type
  51.             chararray=packed array[1..1]of char;
  52.             chararrayptr=^chararray;
  53.             chararrayhdl=^chararrayptr;
  54.         var
  55.             oldA4: LongInt;
  56.             myerr: oserr;
  57.             myclipsize, templongint: longint;
  58.             myclipHandle: handle;
  59.             i: integer;
  60.     begin
  61.         oldA4 := SetCurrentA4;
  62.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  63.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  64.         if myerr=noerr then 
  65.             begin
  66.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  67.                 if myclipsize > 0 then
  68.                     begin
  69.                         for i:=1 to myclipsize-1 do
  70.                             begin
  71.                                 if (chararrayhdl(mycliphandle)^^[i]in[return,enter]) then
  72.                                     begin
  73.                                         if not (chararrayhdl(mycliphandle)^^[i+1] in[return,enter,space,tab,dash,bullet])  then
  74.                                             begin
  75.                                                  chararrayhdl(mycliphandle)^^[i]:=' ';
  76.                                             end
  77.                                         else
  78.                                             begin
  79.                                                  i:=i+1;
  80.                                             end;
  81.                                     end;
  82.                             end;
  83.                         myerr := ZeroScrap;
  84.                         myclipsize:=gethandlesize(mycliphandle);
  85.                         Temphlock(mycliphandle,myerr);
  86.                         myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  87.                         Temphunlock(myCliphandle,myerr);
  88.                         dopaste;
  89.                     end;
  90.             end;
  91.         TempDisposeHandle(myCliphandle,myerr);
  92.         oldA4 := SetA4(oldA4);
  93.     end;
  94. end.